;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Copyright 2021 fanguangping
; 
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
; 
;     http://www.apache.org/licenses/LICENSE-2.0
; 
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#lang racket

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Tree class
;   - left child right sibling tree
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require "../common/constants.scm")
(require "../common/messages.scm")
(require "../common/utils.scm")
(require "Object.scm")

(provide (all-defined-out))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Make TreeNode class
;   -key: represent the node key
;   -value: represent the node data
;   -parent: parent of the node
;   -left-child: left child of the node
;   -right-sibling: right sibling of the node
;   -level: node's level in the tree
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (MAKE-TreeNode self key value parent left-child right-sibling level)
  (lambda (message)
    (cond
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; Getters
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +G-TreeNode-key+)
       (lambda () key))
      ((= message +G-TreeNode-value+)
       (lambda () value))
      ((= message +G-TreeNode-parent+)
       (lambda () parent))
      ((= message +G-TreeNode-left-child+)
       (lambda () left-child))
      ((= message +G-TreeNode-right-sibling+)
       (lambda () right-sibling))
      ((= message +G-TreeNode-level+)
       (lambda () level))
      
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; Setters
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +S-TreeNode-key+)
       (lambda (NEW-key) (set! key NEW-key)))
      ((= message +S-TreeNode-value+)
       (lambda (NEW-value) (set! value NEW-value)))
      ((= message +S-TreeNode-parent+)
       (lambda (NEW-parent) (set! parent NEW-parent)))
      ((= message +S-TreeNode-left-child+)
       (lambda (NEW-left-child) (set! left-child NEW-left-child)))
      ((= message +S-TreeNode-right-sibling+)
       (lambda (NEW-right-sibling) (set! right-sibling NEW-right-sibling)))
      ((= message +S-TreeNode-level+)
       (lambda (NEW-level) (set! level NEW-level)))

      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; TODO: equals
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +M-Object-equals+)
       (lambda (other)
         '()))

      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; TODO: hash code
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +M-Object-hash-code+)
       (lambda ()
         '()))
      
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; TODO: to string
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +M-Object-to-string+)
       (lambda ()
         '()))
      
      (else +nil+))))

(define (CREATE-TreeNode k v p lc rs level)
  (create-instance MAKE-TreeNode k v p lc rs level))

(define (tree-node-key node)
  (ask node +G-TreeNode-key+))
(define (tree-node-value node)
  (ask node +G-TreeNode-value+))
(define (tree-node-parent node)
  (ask node +G-TreeNode-parent+))
(define (tree-node-lc node)
  (ask node +G-TreeNode-left-child+))
(define (tree-node-rs node)
  (ask node +G-TreeNode-right-sibling+))
(define (tree-node-level node)
  (ask node +G-TreeNode-level+))

(define (tree-node-key! node key)
  (ask node +S-TreeNode-key+ key))
(define (tree-node-value! node value)
  (ask node +S-TreeNode-value+ value))
(define (tree-node-lc! node lc)
  (ask node +S-TreeNode-left-child+ lc))
(define (tree-node-rs! node rs)
  (ask node +S-TreeNode-right-sibling+ rs))
(define (tree-node-parent! node parent)
  (ask node +S-TreeNode-parent+ parent))
(define (tree-node-level! node level)
  (ask node +S-TreeNode-level+ level))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Make Tree class
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (MAKE-Tree self root)
  (define (recur-travel-tree t f)
    (if (null? t) t
        (begin (f t)
               (recur-travel-tree (tree-node-lc t) f)
               (recur-travel-tree (tree-node-rs t) f))))

  (define (tree-node-add! node-chain)
    (define (find-slot-in-children children key)
      (if (null? children) +nil+
          (let ((slot (car children)))
            (if (object-equals? (tree-node-key slot) key)
                slot
                (find-slot-in-children (cdr children) key)))))
    (define (get-children sibling-node)
      (if (null? sibling-node) +nil+
          (cons sibling-node (get-children (tree-node-rs sibling-node)))))
    (define (find-slot-to-add ancestor-node descendants)
      (if (null? descendants)
          (cons ancestor-node descendants)
          (let* ((key (caar descendants))
                 (lc (tree-node-lc ancestor-node))
                 (siblings (get-children lc))
                 (slot (find-slot-in-children siblings key)))
            (if (null? slot)
                (cons ancestor-node descendants)
                (find-slot-to-add slot (cdr descendants))))))
    (define (find-right-sibling node)
      (if (null? (tree-node-rs node))
          node
          (find-right-sibling (tree-node-rs node))))
    (define (add-descendants ancestor-node descendants)
      (if (null? descendants) +nil+
          (let* ((key (caar descendants))
                 (value (cdar descendants))
                 (node (CREATE-TreeNode key value ancestor-node +nil+ +nil+ 0)))
            (if (null? (tree-node-lc ancestor-node))
                (tree-node-lc! ancestor-node node)
                (tree-node-rs! (find-right-sibling (tree-node-lc ancestor-node)) node))
            (add-descendants node (cdr descendants)))))
    (let ((slot (find-slot-to-add root node-chain)))
      (add-descendants (car slot) (cdr slot))))
  
  (lambda (message)
    (cond
      ((= message +G-Tree-root+)
       (lambda () root))
      ((= message +S-Tree-root+)
       (lambda (NEW-root) (set! root NEW-root)))
      
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; Travel tree by function f
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +M-Tree-travel+)
       (lambda (f)
         (recur-travel-tree root f)))

      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; Add chained node to tree
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +M-Tree-add-chain+)
       (lambda (node-chain)
         (tree-node-add! node-chain)))

      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; TODO: equals
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +M-Object-equals+)
       (lambda (other)
         '()))

      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; TODO: hash code
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +M-Object-hash-code+)
       (lambda ()
         '()))
      
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; TODO: to string
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +M-Object-to-string+)
       (lambda ()
         '()))

      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ; type
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ((= message +M-Object-type+)
       (lambda () 'Tree))
      
      (else +nil+))))

(define (CREATE-Tree root)
  (create-instance MAKE-Tree root))

(define (tree-root tree)
  (ask tree +G-Tree-root+))
(define (tree-root! tree)
  (ask tree +S-Tree-root+))
(define (tree-travel tree f)
  (ask tree +M-Tree-travel+ f))
(define (tree-add-chain! tree node-chain)
  (ask tree +M-Tree-add-chain+ node-chain))
